home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / win.tcl < prev    next >
Encoding:
Text File  |  1994-09-03  |  6.4 KB  |  282 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. #    Window handling routines. All procs are bound in AlphaBits.tcl.
  3. #=============================================================================
  4.  
  5. proc shrinkHigh {} {
  6.     global tileTop
  7.     set text [getGeometry]
  8.     set left [lindex $text 0]
  9.     set top [lindex $text 1]
  10.     set width [lindex $text 2]
  11.     sizeWin $width 150
  12.     moveWin $left $tileTop
  13. }
  14.  
  15. proc shrinkLow {} {
  16.     set text [getGeometry]
  17.     set left [lindex $text 0]
  18.     set top [lindex $text 1]
  19.     set width [lindex $text 2]
  20.     moveWin $left 315
  21.     sizeWin $width 146
  22. }
  23.  
  24. proc shrinkFull {} {
  25.     global tileTop tileHeight
  26.     moveWin 2 $tileTop
  27.     sizeWin 510 $tileHeight
  28. }
  29.  
  30. proc shrinkLeft {} {
  31.     global tileWidth tileTop tileHeight
  32.     
  33.     set margin 4
  34.     set width [expr ($tileWidth/2)-$margin]
  35.     set text [getGeometry]
  36.     set width [expr ($tileWidth/2)-$margin]
  37.     set width [expr {$width + $margin / 2}]
  38.     moveWin 2 $tileTop
  39.     sizeWin $width $tileHeight
  40. }
  41.  
  42. proc shrinkRight {} {
  43.     global tileWidth tileTop tileHeight
  44.     
  45.     set margin 4
  46.     set width [expr ($tileWidth/2)-$margin]
  47.     set text [getGeometry]
  48.     set width [expr ($tileWidth/2)-$margin]
  49.     set width [expr {$width + $margin / 2}]
  50.     moveWin [expr 2 + $width + $margin] $tileTop
  51.     sizeWin $width $tileHeight
  52. }
  53.  
  54. proc swapWithNext {} {
  55.     set files [winNames -f]
  56.     if {[llength $files] < 2} return
  57.     bringToFront [lindex $files 1]
  58. }
  59.     
  60.  
  61.  
  62. proc nextWindow {} {
  63.     global winActive 
  64.     set files [winNames -f]
  65.     if {[llength $files] < 2} {return}
  66.     set f [lindex $files 0]
  67.     set aind [lsearch $winActive $f]
  68.     if {$aind < 0} {error "No win '$f'"}
  69.     set rng [lrange $winActive 0 [expr $aind-1]]
  70.     set winActive [concat [lrange $winActive $aind end] $rng]
  71.     set winActive [lrange $winActive 1 end]
  72.     lappend winActive $f
  73.     bringToFront [lindex $winActive 0]
  74. }
  75.  
  76.  
  77. proc prevWindow {} {
  78.     global winActive 
  79.     set files [winNames -f]
  80.     if {[llength $files] < 2} {return}
  81.     set f [lindex $files 0]
  82.     set aind [lsearch $winActive $f]
  83.     if {$aind < 0} {error "No win '$f'"}
  84.     set rng [lrange $winActive 0 [expr $aind-1]]
  85.     set winActive [concat [lrange $winActive $aind end] $rng]
  86.     set f2 [lindex [lrange $winActive end end] 0]
  87.     set winActive [lreplace $winActive end end]
  88.     set winActive [linsert $winActive 0 $f2]
  89.     bringToFront $f2
  90. }
  91.  
  92. proc dispFullName {} {
  93.     message [lindex [winNames -f] 0]
  94. }
  95.  
  96. proc vertically {} {
  97.     global tileHeight tileTop tileWidth
  98.     global numWinsToTile
  99.     set margin 22
  100.     set names [winNames -f]
  101.     set numWins [llength $names]
  102.     if ($numWins<=1) return
  103.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  104.     set height [expr ($tileHeight/$numWins)-$margin]
  105.     set height [expr {$height + $margin / $numWins}]
  106.     set width $tileWidth
  107.     set ver $tileTop
  108.     if {$numWins == 0} {return}
  109.  
  110.     for {set i 0} {$i < $numWins} {incr i} {
  111.         moveWin [lindex $names $i] 1000 0
  112.         sizeWin [lindex $names $i] $width $height
  113.     }
  114.  
  115.     for {set i 0} {$i < $numWins} {incr i} {
  116.         moveWin [lindex $names $i] 3 $ver
  117.         set ver [expr $ver+$margin+$height]
  118.     }
  119. }
  120.  
  121. proc horizontally {} {
  122.     global tileHeight tileWidth tileTop numWinsToTile
  123.  
  124.     set names [winNames -f]
  125.     set numWins [llength $names]
  126.     if ($numWins<=1) return
  127.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  128.     set margin 4
  129.     set width [expr ($tileWidth/$numWins)-$margin]
  130.     set width [expr {$width + $margin / $numWins}]
  131.     set height $tileHeight
  132.     set hor 2
  133.     if {$numWins == 0} {return}
  134.  
  135.     for {set i 0} {$i < $numWins} {incr i} {
  136.         moveWin [lindex $names $i] 1000 0
  137.         sizeWin [lindex $names $i] $width $height
  138.     }
  139.  
  140.     for {set i 0} {$i < $numWins} {incr i} {
  141.         moveWin [lindex $names $i] $hor $tileTop
  142.         set hor [expr $hor+$width+$margin]
  143.     }
  144. }
  145.  
  146. proc tiled {} {
  147.     global tileHeight tileWidth numWinsToTile tileTop
  148.     set xPan 8
  149.     set yPan 10
  150.     set xMarg 3
  151.     set yMarg $tileTop
  152.     set yMax 50
  153.     set names [winNames -f]
  154.     set numWins [llength $names]
  155.     if ($numWins<1) return
  156.     set line 0    
  157.     set height [expr $tileHeight-$yPan*($numWins-1)]
  158.     set width [expr $tileWidth-$xPan*($numWins-1)]
  159.     
  160.     for {set i 0} {$i < $numWins} {incr i} {
  161.         moveWin [lindex $names $i] [expr $xMarg+$i*$xPan] [expr $yMarg+$line]
  162.         set line [expr $line+$yPan]
  163.         if ($line>$yMax) {set line 0}
  164.         sizeWin [lindex $names $i] $width $height
  165.     }
  166. }
  167.  
  168.  
  169. proc overlay {} {
  170.     global defHeight defWidth numWinsToTile tileTop
  171.     set names [winNames -f]
  172.     set numWins [llength $names]
  173.     if ($numWins<1) return
  174.     for {set i 0} {$i < $numWins} {incr i} {
  175.         moveWin [lindex $names $i] 3 $tileTop
  176.         sizeWin [lindex $names $i] $defWidth $defHeight
  177.     }
  178. }
  179.  
  180.  
  181. proc threeQuarters {} {
  182.     global tileHeight tileWidth tileTop
  183.  
  184.     if {[llength [set nms [winNames -f]]] <= 2} return
  185.     set one [lindex $nms 0]
  186.     set two [lindex $nms 1]
  187.     set margin 22
  188.     set height [expr ($tileHeight - $margin) / 4]
  189.  
  190.     moveWin $one 1000 0
  191.     sizeWin $one $tileWidth [expr 3 * $height]
  192.     moveWin $two 1000 0
  193.     sizeWin $two $tileWidth $height
  194.  
  195.     set ver $tileTop
  196.     moveWin $one 3 $ver
  197.     moveWin $two 3 [expr $ver + 3 * $height + $margin]
  198. }
  199. bind '3' <Q> threeQuarters
  200.  
  201.  
  202. proc chooseAWindow {} {
  203.     set name [listpick [lsort -ignore [winNames]]]
  204.     if {[string length $name]} {
  205.         bringToFront $name
  206.         if [icon -q] { icon -f $name -o }
  207.        }
  208. }
  209.  
  210.  
  211. proc winComp {curr c} {
  212.     if {$c != "\t"} {return $c}
  213.     
  214.     set matches {}
  215.     foreach w [winNames] {
  216.         if {[string match "$curr*" $w]} {
  217.             lappend matches $w
  218.         }
  219.     }
  220.     if {![llength $matches]} {
  221.         beep
  222.     } elseif {[llength $matches] == 1} {
  223.         return [string range [lindex $matches 0] [string length $curr] end]
  224.     }
  225.     return ""
  226. }
  227.  
  228. proc nextWin {} {
  229.     global winActive 
  230.     set files [winNames -f]
  231.     if {[llength $files] < 2} {return ""}
  232.     set f [lindex $files 0]
  233.     set aind [lsearch $winActive $f]
  234.     if {$aind < 0} {error "No win '$f'"}
  235.     if {[incr aind] < [llength $winActive]} {
  236.         return [file tail [lindex $winActive $aind]]
  237.     } else {
  238.         return [file tail [lindex $winActive 0]]
  239.     }
  240. }
  241.  
  242. proc chooseWindowStatus {} {
  243.     if {[llength [winNames]] < 2} {message "no other window."; return}
  244.     set next [nextWin]
  245.     set res [statusPrompt "Goto window: ($next):" winComp]
  246.     if {[string length $res]} {
  247.         catch {bringToFront $res}
  248.     } else {
  249.         catch {bringToFront $next}
  250.     }
  251. }
  252. bind f9 chooseWindowStatus
  253.  
  254. proc iconify {} { 
  255.     icon -t 
  256. }
  257.  
  258.  
  259.  
  260. proc zoom {} {
  261.     global nzmState tileHeight tileWidth zoomedGeo tileTop
  262.     
  263.     set win [lindex [winNames -f] 0]
  264.     if {[info exists nzmState($win)]} {
  265.         if {[getGeometry] == $zoomedGeo} {
  266.             set state $nzmState($win)
  267.             moveWin [lindex $state 0] [lindex $state 1]
  268.             sizeWin [lindex $state 2] [lindex $state 3]
  269.             unset nzmState($win)
  270.             return
  271.         }
  272.     } 
  273.  
  274.     set nzmState($win) [getGeometry]
  275.     moveWin 3 $tileTop
  276.     sizeWin $tileWidth $tileHeight
  277.  
  278.     if {![info exists zoomedGeo]} {
  279.         set zoomedGeo [getGeometry]
  280.     }
  281. }
  282.